home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / intrfc70.zip / SRCFILES.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-16  |  7KB  |  268 lines
  1. unit srcfiles;
  2. {$I SWITCHES.INC}
  3.  
  4. interface
  5.  
  6. uses dos,globals,util,dump,loader,head;
  7.  
  8. type
  9.   src_file_ptr = ^src_file_rec;
  10.   src_file_rec = record
  11.     filetype : byte;
  12.     w1 : word;
  13.     packed_date : longint;
  14.     filename : string;
  15.   end;
  16.  
  17.   src_line_ptr = ^src_line_rec;
  18.   src_line_rec = record
  19.     owner_ofs,
  20.     src_ofs,
  21. {$IFNDEF UNIT60}
  22.     header_line,
  23. {$ENDIF}
  24.     entry,startline,numlines : word;
  25.   end;
  26.  
  27.   src_lines_count_ptr = ^src_lines_count_rec;
  28.   src_lines_count_rec = record
  29.     w0,w1,
  30.     count:word;
  31.   end;
  32.  
  33.    browser_ptr = ^browser_rec;
  34.    browser_rec = record
  35.      ofs,
  36.      line:word;
  37.    end;
  38.  
  39. procedure print_src_files;
  40. procedure print_src_lines;
  41. procedure print_browser;
  42.  
  43. implementation
  44.  
  45. uses blocks;
  46.  
  47. function tf(w:word):string;  { Time format of a number }
  48. var
  49.   result : string[3];   { Use length 3 in to show errors }
  50. begin
  51.   str(w,result);
  52.   if length(result) = 1 then
  53.     tf := '0'+result
  54.   else
  55.     tf := result;
  56. end;
  57.  
  58. procedure print_src_files;
  59. const
  60.   monthname : array[1..12] of string[9] = ('January','February',
  61.                                             'March','April','May',
  62.                                             'June','July','August',
  63.                                             'September','October',
  64.                                             'November','December');
  65. var
  66.   thisfile : src_file_ptr;
  67.   ofs : word;
  68.   dt : datetime;
  69. begin
  70.   writeln;
  71.   writeln('Source File Records');
  72.   ofs := header^.ofs_src_name;
  73. {$IFDEF UNIT60}
  74.   while ofs < header^.ofs_line_lengths do
  75. {$ELSE}
  76.   while ofs < header^.ofs_line_count do
  77. {$ENDIF}
  78.   begin
  79.     thisfile := add_only_offset(buffer,ofs);
  80.     with thisfile^ do
  81.     begin
  82.       case filetype of
  83.       3 : write('Includes ');
  84.       4 : write('Main src ');
  85.       5 : write('Links to ');
  86.       6 : write('Resource ');
  87.       else
  88.           WriteError('Unknown file type '+DecWord(filetype)+' ');
  89.       end;
  90.       write(filename);
  91.       if packed_date <> 0 then
  92.       begin
  93.         unpacktime(packed_date,dt);
  94.         with dt do
  95.           write(' ':(15-length(filename)),tf(hour),':',tf(min),':',tf(sec),' ',monthname[month],' ',day,', ',year);
  96.       end;
  97.       if w1 <> 0 then
  98.         WriteError(' unknown w1 = '+HexWord(w1));
  99.       writeln;
  100.       inc(ofs,sizeof(src_file_rec)-255+length(filename));
  101.     end;
  102.   end;
  103. end;
  104.  
  105. procedure print_src_lines;
  106. var
  107.   ofs : word;
  108.   line,i,codeofs : word;
  109.   thisrec : src_line_ptr;
  110.   obj : obj_ptr;
  111.   bytes_per_line : byte_array_ptr;
  112.   name : string;
  113.   src_file : src_file_ptr;
  114.   column : byte;
  115.   src_lines_count: src_lines_count_ptr;
  116. begin
  117.   writeln;
  118. {$IFNDEF UNIT60}
  119.   src_lines_count := add_only_offset(buffer,header^.ofs_line_count);
  120.   writeln('Total lines: ',src_lines_count^.Count);
  121.   if src_lines_count^.w0<>0 then
  122.     WriteError('Count lines w0<>0');
  123.   if src_lines_count^.w1<>0 then
  124.     WriteError('Count lines w1<>0');
  125.   writeln;
  126. {$ENDIF}
  127.   writeln('Source Line Numbers');
  128.   column := 1;
  129.   ofs := header^.ofs_line_lengths;
  130.   if ofs = header^.sym_size then
  131.     writeln('(none)')
  132.   else
  133.   begin
  134.     writeln;
  135.     while ofs < header^.sym_size do
  136.     begin
  137.       thisrec := add_only_offset(buffer,ofs);
  138.       with thisrec^ do
  139.       begin
  140.         if owner_ofs <> 0 then
  141.         begin
  142.           obj := add_only_offset(buffer,owner_ofs);
  143.           name := obj^.name;
  144.         end
  145.         else
  146.           name := 'initialization code';
  147.         src_file := add_only_offset(buffer,header^.ofs_src_name+src_ofs);
  148.         if (owner_ofs=0) and (src_file^.filetype=3) then
  149.           writeln('Line number offsets in ',src_file^.filename)
  150.         else
  151.           writeln('Line number offsets for ',name,' in ',src_file^.filename);
  152.         bytes_per_line := add_only_offset(thisrec,sizeof(src_line_rec));
  153. {$IFNDEF UNIT60}
  154.         write(header_line:6,':Head');
  155.         column := 1;
  156. {$ELSE}
  157.         column := 0;
  158. {$ENDIF}
  159.         line := 0;
  160.         i := 0;
  161.         codeofs := entry;
  162.         while line < numlines do
  163.         begin
  164.           if bytes_per_line^[i] > 0 then
  165.           begin
  166.             write(startline+line:6,':',hexword(codeofs):4);
  167.             inc(column);
  168.             if column = 7 then
  169.             begin
  170.               column := 0;
  171.               writeln;
  172.             end;
  173.             if bytes_per_line^[i] >= $80 then
  174.             begin
  175.               inc(codeofs,$100*(bytes_per_line^[i]-$80)
  176.                                +bytes_per_line^[i+1]);
  177.               inc(i);
  178.             end
  179.             else
  180.               inc(codeofs,bytes_per_line^[i]);
  181.           end;
  182.           inc(line);
  183.           inc(i);
  184.         end;
  185.         inc(ofs,sizeof(thisrec^)+i);
  186.       end;
  187.       if column <> 0 then
  188.         writeln;
  189.     end;
  190.   end;
  191. end;
  192. procedure print_browser;
  193. var
  194.   br_item:browser_ptr;
  195.   i,i2,line:word;
  196.   obj:obj_ptr;
  197.   base,ofs,limit:word;
  198.   block : unit_block_ptr;
  199.   buf : byte_array_ptr;
  200.   unit_ptr:unit_list_ptr;
  201. begin
  202. {$IFNDEF UNIT60}
  203.   writeln;
  204.   writeln('Browser information');
  205.   if header^.browser_size = 0 then
  206.   begin
  207.     writeln('(none)');
  208.     exit;
  209.   end;
  210.   i:=0;
  211.   line:=0;
  212.   write('    Line Declared symbols');
  213.   while i<header^.br_defs_end do
  214.   begin
  215.     br_item:=add_only_offset(browser_buf,i);
  216.     if br_item^.line<>line then
  217.     begin
  218.       Writeln;
  219.       line:=br_item^.line;
  220.       Write(line:8);
  221.     end;
  222.     obj:=add_only_offset(buffer,br_item^.ofs);
  223.     write(' ',obj^.name);
  224.     inc(i,sizeof(br_item^));
  225.   end;
  226.   writeln;
  227.   ofs := 0;
  228.   base := header^.ofs_unit_list;
  229.   limit := header^.ofs_src_name;
  230.   i2:=0;
  231.   while base+ofs < limit do
  232.   begin
  233.     block := add_only_offset(buffer,base+ofs);
  234.     with block^ do
  235.     begin
  236.       Writeln;
  237.       Write('    Line Referenced symbols from unit ',name);
  238.       unit_ptr:=get_unit_by_name(name);
  239.       if (unit_ptr<>nil) and (unit_ptr^.buffer<>nil) then
  240.       begin
  241.         buf:=unit_ptr^.buffer;
  242.         i:=0;
  243.         line:=0;
  244.         while i<refcount do
  245.         begin
  246.           br_item:=add_only_offset(browser_buf,i+i2+header^.br_defs_end);
  247.           if br_item^.line<>line then
  248.           begin
  249.             Writeln;
  250.             line:=br_item^.line;
  251.             Write(line:8);
  252.           end;
  253.           obj:=add_only_offset(buf,br_item^.ofs);
  254.           write(' ',obj^.name);
  255.           inc(i,sizeof(br_item^));
  256.         end;
  257.       end;
  258.       Inc(i2,refcount);
  259.       Inc(ofs,5 + length(name));
  260.       writeln;
  261.     end;
  262.   end;
  263. {$ENDIF}
  264. end;
  265.  
  266.  
  267. end.
  268.